home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tricks of the Mac Game Programming Gurus
/
TricksOfTheMacGameProgrammingGurus.iso
/
More Source
/
Libraries
/
SAT 2.3b4
/
Misc
/
TransSkel
/
TransSkel.p
< prev
Wrap
Text File
|
1995-01-27
|
54KB
|
1,723 lines
{ TransSkel version 2.00 - Transportable application skeleton}
{ TransSkel is public domain and was originally written in LightSpeed C by:}
{ Paul DuBois}
{ Wisconsin Regional Primate Research Center}
{ 1220 Capital Court}
{ Madison WI 53706 USA}
{ UUCP: [allegra,ihnp4,seismo]!uwvax!rhesus!dubois }
{ ARPA: dubois@rhesus.primate.wisc.edu}
{ The Pascal Version of TransSkel is public domain and was ported and changed by }
{ Owen Hartnett }
{ Ωhm Software }
{ 163 Richard Drive }
{ Tiverton, RI 02878 }
{ CSNET: omh@cs.brown.edu.CSNET }
{ ARPA: omh%cs.brown.edu }
{ UUCP: [ihnp4,allegra]!brunix !omh }
{ This version of TransSkel written for Lightspeed Pascal. Lightspeed Pascal is a}
{ trademark of:}
{ THINK Technologies, Inc}
{ 420 Bedford Street Suite 350}
{ Lexington, MA 02173 USA}
{ History}
{ 06/13/86 Beta version. (pd) }
{ 08/27/86 Version number changed to 1.01.(pd)}
{ v1.0 DoGrow bug fixed - the port at the point of the}
{ InvalRect could have been anything; the fix is to set}
{ the port to the grown window first. This also explains}
{ why the kludge to DoActivate in v1.0 worked.(pd)}
{ 10/02/86 Version number changed to 1.02, as a result of adding}
{ modifications by David W. Berry (well!dwb@lll-lcc.arpa)}
{ for supporting window zooming. Also used his modifications}
{ for supporting modeless dialogs (though not in the same}
{ form). Dialogs can be #define'd on or off.(pd)}
{12/ 28 / 86 Version number changed to 1.03 . Modified to work under LightspeedC v . 2.01 }
{ - took out definitions for window zooming stuff , as it is now supported by the compiler}
{ directly . Also declared DoZoom static , fixing an oversight . ( pd )}
{ 01 / 18 / 86 Put a SetPort into DoZoom - ZoomWindow requires port to be}
{ set to window being zoomed . ( pd )}
{ 02 / 05 / 86 Version number changed to 1.04 . Big change : port setting behavior made explicit}
{ - the only persistant switch occurs when a window comes active . This changes }
{ underlying programming model ( see manual for detailed discussion ) . Thanks to}
{ Duane Williams for pointing out that this should be done . Typedef 'd }
{ integer/long variables to Integer, Longint to facilitate coversion to other C }
{ compilers . More complete type-casting done . LightspeedC does a lot of it }
{ automatically , other compilers may not . ( pd - this version never released ) }
{03 / 02 / 87 Fixed bug whereby clicks in drag region of non - active windows may not bring }
{ window to front . Seems to be due to DragWindow calling StillDown to see if mouse is still }
{ down . If the machine was busy otherwise when click occurred and }
{ mouse already up when DragWindow is called , the click ends up being ignored . }
{ Thanks to Roger Humphrey for finding this one . }
{* * * Changes implemented first by omh to Pascal Version}
{ 12/24/86 Finished first Pascal version. Dialogs cannot be defined off. (omh)}
{4 / 18 / 87 Changed Desk Accessory code so it 's more tolerant of memory}
{ conditions for desk accessories . ( omh ) }
{7 / 12 / 87 Added "cache " code to GetWDHandler . Now TransSkel figures }
{ that an event is most likely to occur for the same window as the previous }
{ event . Thus the WindowPtr and WDHandle for events are cached and examined }
{ to avoid searching through the handler list . ( omh ) }
{7 / 12 / 87 Excised the notorious "SetPort "excess . As pointed out by Duane Williams ,}
{ SetPort traps abounded unnecessarily in version 1.02 . These have been eliminated }
{ now with two exceptions . First , the port is set when a window handler }
{ is installed . The justification for this is that when a handler is installed , it }
{ is likely that further processing will be done on it immediately . The application gets }
{ control immediately after the handler is installed anyway , so this behavior can be manually }
{ overridden where necessary . Second , when a window is activated , the port is}
{ set to it . This follows the model of keeping the port in sync with the }
{ active window . ( omh ) }
{7 / 14 / 87 Added grow zone function installation and MoreMasters to SkelInit , }
{ which now requires two parameters . The first indicates the number of times to call }
{ MoreMasters . The second is a ProcPtr indicating a user - supplied grow zone}
{ function to be called when memory problems occur . If nil , no grow zone}
{ function is installed . ( omh ) }
{7 / 14 / 87 SkelMenu , SkelWindow , and SkelDialog now return zero or non - zero to indicate }
{ failure or success of handler allocation . This could break * all * previous TransSkel }
{ applications ( as will the change to SkelInit , above . Please see the section "How to }
{ adapt old TransSkel to New " in the manual for detailed specifications on }
{ how to convert your old programs . TransSkel becomes more memory conscious}
{ with these changes . The functions SkelMenu , SkelWindow , and }
{ SkelDialog are the only routines which actually allocate memory . Since they may be }
{ called at any time , knowing that you have enough memory becomes important . Thus , }
{ these routines return a value to indicate what happened . If they return zero ,}
{ then memory allocation failed . ( omh ) }
{10 / 21 / 87 Added another parameter to SkelMenu: drawBar: Boolean . This tells SkelMenu }
{ whether to draw the menu bar after adding the Menu . This is done to eliminate }
{ the menus popping up one at a time . Simply call SkelMenu with drawBar false}
{ until the last time you call SkelMenu , then call it (for the last menu )}
{ with drawBar true . ( omh ) }
{10 / 26 / 87 Removed declarations for zoom - in and zoom - out . Added Pascal }
{ changes ( above ) to C version . ( omh )}
{ 02 / 02 / 88 Merged pd 's 1.04 changes with those of omh, above, to create}
{ release version 2.0 . Fixed bug whereby cmd - key equivalents}
{ for menu selections would execute twice if DA window in front . Thanks }
{ to Don Fredkin and Julian Vrieslander for finding this one , and to Don for the}
{ best fix . ( pd ) }
{ 10/28/88 Removed all New Rom calls. }
{ 10/28/88 Added support for conditional compilation for dialogs and MPW support. By setting }
{ the Think_pascal flag to false, TransSkel will run under MPW. Now correctly written for LSP 2.0}
{Some fixes done later by Ingemar Ragnemalm. Search for "Ingemar" fo find these.}
{They include some bug fix and hierarcical menu support (call SkelHMenu instead of SkelMenu}
{for those menus).}
{New fix 18/9-93: Added a filter proc for dialogs, to allow special event processing before}
{an event is passed to IsDialogEvent, when a modeless dialog is in the front. This makes it possible}
{to use user items in modeless dialogs, and to handle return/enter.}
{Added WNE-support. Use SkelSetSleep and SkelSetMouseRgn if you need them. /Ingemar}
{Added FindWindowByRefcon, a routine that is useful for certain multi-window appplications.}
{july -94: Plugged in suspend/resume-handlers, conforming with TransSkel 3.0. (Handler should}
{take a boolean as parameter. If the boolean is true, the application was resumed, otherwise it was}
{suspended.) Processes Apple Events by calling AEProcessAppleEvent for you.}
unit TransSkel;
interface
{$IFC UNDEFINED GENERATINGPOWERPC }
{$SETC GENERATINGPOWERPC:= false }
{$ENDC}
{$SETC supportDialogs:= true }
{ Set to false to disallow modeless dialog support and save code space }
{ Set to false to have SkelInit call QuickDraw Inits: InitGraf, InitDialog, etc. }
{$IFC UNDEFINED THINK_PASCAL}
uses
Types, Quickdraw,{, OSIntf, ToolIntf, PackIntf}
Menus, Windows, Memory, SegLoad, Scrap, ToolUtils, Fonts,{}
{$IFC GENERATINGPOWERPC }
PPCTransSkelCallProcs,
{$ENDC}
Devices, TextEdit, Traps, Events, Dialogs, Resources, DiskInit, AppleEvents;
{$ELSEC}
uses
InterfacesUI; {UPI interfaces in one file for Think Pascal}
{$ENDC}
procedure SkelInit (noMasters: integer; myGrowZone: ProcPtr);
procedure SkelMain;
procedure SkelWhoa;
procedure SkelClobber;
function SkelMenu (theMenu: MenuHandle; pSelect: ProcPtr; pClobber: ProcPtr; DrawBar: Boolean): Boolean;
function SkelHMenu (theMenu: MenuHandle; pSelect: ProcPtr; pClobber: ProcPtr): Boolean; {Added by Ingemar 22/8 -93}
procedure SkelRmveMenu (theMenu: MenuHandle);
procedure SkelApple (aboutTitle: Str255; aboutProc: ProcPtr);
function SkelWindow (theWind: WindowPtr; pMouse, pKey, pUpdate, pActivate, pClose, pClobber, pIdle: ProcPtr; frontOnly: Boolean): Boolean;
procedure SkelRmveWind (theWind: WindowPtr);
{$IFC supportDialogs }
function SkelDialog (theDialog: DialogPtr; pEvent, pClose, pClobber, pFilter: ProcPtr): Boolean; {pFilter added by Ingemar 18/9-93}
procedure SkelRmveDlog (theDialog: DialogPtr);
{$ENDC}
procedure SkelGrowBounds (theWind: WindowPtr; hLO, vLo, hHi, vHi: integer);
procedure SkelEventMask (mask: integer);
procedure SkelGetEventMask (var mask: integer);
procedure SkelBackground (p: ProcPtr);
procedure SkelGetBackground (var p: ProcPtr);
procedure SkelEventHook (p: ProcPtr);
procedure SkelGetEventHook (var p: ProcPtr);
{$IFC supportDialogs }
procedure SkelDlogMask (mask: integer);
procedure SkelGetDlogMask (var mask: integer);
{$ENDC}
{Two new procedures for WNE-support, added by Ingemar 12/11-93}
procedure SkelSetSleep (newSleep: Longint);
procedure SkelSetMouseRgn (newMouseRgn: RgnHandle);
{Utility function, added by Ingemar 13/7-94}
function FindWindowByRefcon (theRefCon: Longint): WindowPtr;
{Suspend/resume, added by Ingemar 23/7 -94}
procedure SkelSetSuspendResume (p: ProcPtr);
function SkelGetSuspendResume: ProcPtr;
implementation
{Some stuff that are here to avoid including EPPC and AppleEvents, added by Ingemar 23/7 -94}
{const}
{ kHighLevelEvent = 23;}
{ function AEProcessAppleEvent (theEventRecord: EventRecord): OSErr;}
{ inline}
{ $303C, $021B, $A816;}
const
mBarHeight = 20; { menu bar height. All window sizing}
GrowZoneSize = 4000; { Size of memory to be freed when GrowZone Proc called }
defaultSleep = 5; { Added by Ingemar dec -93. SkelInit uses this value for sleep time.}
{ The programmer can change it with SkelSetSleep }
{ This window zooming stuff may need to be removed if you use the new Rom libraries }
{ if not, then you can add zooming without the overhead of the new Rom libs. See TrackBox }
{ routine also. }
{ Window and Menu handler types, constants, variables.}
{ whList and mhList are the lists of window and menu handlers.}
{ whClobOnRmve and mhClobOnRmve are true if the handler disposal proc}
{ is to be called when a handler is removed. They are temporarily set}
{ false when handlers are installed for windows or menus that already}
{ have handlers - the old handler is removed WITHOUT calling the}
{ disposal proc.}
{ Default lower limits on window sizing of 80 pixels both directions is}
{ sufficient to allow text windows room to draw a grow box and scroll}
{ bars without having the thumb and arrows overlap. These values may}
{ be changed if such a constraint is undesirable with SkelGrowBounds.}
{ Default upper limits are for the Macintosh, not the Lisa, but are set}
{ per machine in SkelInit.}
type
WHandlerPtr = ^WHandler;
WHandlerHnd = ^WHandlerPtr;
WHandler = record
whWind: WindowPtr; {window/dialog to be handled }
whClobber: ProcPtr; { data structure disposal proc }
whMouse: ProcPtr; { mouse-click handler proc }
whKey: ProcPtr; { key-click handler proc }
whUpdate: ProcPtr; { update handler proc }
whActivate: ProcPtr; { activate event handler proc }
whClose: ProcPtr; { close "event" handler proc }
whIdle: ProcPtr; { main loop proc }
{$IFC supportDialogs }
whEvent: ProcPtr; { dialog event proc }
whFilter: ProcPtr; { dialog filter proc ADDED BY INGEMAR 18/9 -93}
{$ENDC }
whHasGrow: Boolean; { can window grow? }
whGrow: Rect; { limits on window sizing }
whSized: Boolean; { true = window was resized }
whFrontOnly: Boolean; { true = idle only when active }
whNext: WHandlerHnd; { next window handler }
end;
MHandlerPtr = ^MHandler;
MHandlerHnd = ^MHandlerPtr;
MHandler = record
mhID: integer; { menu id }
mhSelect: ProcPtr; { item selection handler proc }
mhClobber: ProcPtr; { menu disposal handler proc }
mhNext: MHandlerHnd; { next menu handler }
end;
var
whList: WHandlerHnd; { list of menu handlers }
whClobOnRmve: Boolean;
growRect: Rect;
mhList: MHandlerHnd;
mhClobOnRmve: Boolean;
{ Variables for default Apple menu handler. appleID is set to 1 if}
{ SkelApple is called and is the id of the Apple menu, appleAboutProc}
{ is the procedure to execute if there is an About... item and it's}
{ chosen from the Apple menu. If doAbout is true, then the menu}
{ contains the About... item, otherwise it's just desk accessories.}
appleMenu: MenuHandle;
appleID: integer;
appleAboutProc: ProcPtr;
doAbout: Boolean;
{ Miscellaneous}
{ screenPort points to the window manager port.}
{ doneFlag determines when SkelMain returns. It is set by calling}
{ SkelWhoa(), which the host does to request a halt.}
{ pBkgnd points to a background procedure, to be run during event}
{ processing. Set it with SkelBackground. If nil, there's no}
{ procedure.}
{ pEvent points to an event-inspecting hook, to be run whenever an}
{ event occurs. Set it with SkelEventHook. If nil, there's no}
{ procedure.}
{ eventMask controls the event types requested in the GetNextEvent}
{ call in SkelMain.}
{ diskInitPt is the location at which the disk initialization dialog}
{ appears, if an uninitialized disk is inserted.}
screenPort: GrafPtr;
doneFlag: integer;
pBkgnd: ProcPtr;
pEvent: ProcPtr;
eventMask: integer;
diskInitPt: Point;
{Added by Ingemar 12/11-93, for WNE-support:}
WNEImplemented: Boolean;
sleepTicks: Longint;
mouseRgn: rgnHandle;
{…and later, for suspend/resume support:}
gSuspendResumeHandler: ProcPtr;
{$IFC supportDialogs }
{ Events that are passed to dialogs. Others are ignored.}
{ Standard mask passes , mousedown, keydown, autokey, update,}
{ activate and null events. Null events are controlled by bit 0.}
dlogEventMask: integer;
{$ENDC}
pEventflag: Boolean;
{ "caching" global variables. previous version would search down the window }
{ list for every event it found. Now, if the event happened to the same window }
{ as last time, GetWDHandler will just do a simple compare }
{ and return the last window handler. This speeds up multiple window applications }
{ immensely, at only a slight cost when you activate a new window (one }
{ compare!) If you don't like it, use the old version. }
oldWindow: WindowPtr;
oldWDHandler: WHandlerHnd;
{ Global for built in "Grow Zone" function }
safetyHandle: Handle;
myDitl: packed array[0..100] of byte;
{ Rather than including the entire new ROM libraries, with all the other stuff you might not use }
{ I've instead included just the Zoom box stuff here. Depending on your status, you can either }
{ leave things as they are, and only use zooming from the new Rom libs, or comment out the }
{ calls, and include the new Rom libraries if you want to incorporate other new Rom calls }
{ -------------------------------------------------------------------- }
{ Internal (private) Routines }
{ -------------------------------------------------------------------- }
{ Get handler associated with user or dialog window.}
{ Return nil if window doesn't belong to any known handler.}
{ This routine is absolutely fundamental to TransSkel.}
function GetWDHandler (theWind: WindowPtr): WHandlerHnd;
var
h: WHandlerHnd;
begin
h := WhList;
GetWDHandler := nil;
if theWind = oldWindow then { caching code }
GetWDHandler := oldWDHandler
else
while h <> nil do
if h^^.whWind = theWind then
begin
oldWindow := theWind; { Load in new values for new window }
oldWDHandler := h;
GetWDHandler := h;
h := nil;
end
else
h := WHandlerHnd(h^^.whNext);
end;
{ Get Handler associated with user window. Return nil if window doesn't}
{ have a Handler. }
function GetWHandler (theWind: WindowPtr): WHandlerHnd;
var
h: WHandlerHnd;
myPeek: WindowPeek;
begin
{BUG FIXED by Ingemar 19/9-93. This function retured garbage when passed a dialog}
h := GetWDHandler(theWind);
myPeek := WindowPeek(theWind);
GetWHandler := nil; {default, moved up by Ingemar}
if h <> nil then
begin
if mypeek^.windowKind <> dialogKind then
GetWHandler := h;
end;
end;
{$IFC supportDialogs }
{ Get handler associated with dialog window.}
{ Return nil if window doesn't belong to any known handler.}
function GetDHandler (theDialog: WindowPtr): WHandlerHnd;
var
h: WHandlerHnd;
myPeek: WindowPeek;
begin
{BUG FIXED by Ingemar 19/9-93. This function retured garbage when passed a non-dialog}
h := GetWDHandler(theDialog);
myPeek := WindowPeek(theDialog);
GetDHandler := nil; {default - moved up by Ingemar}
if h <> nil then
begin
if mypeek^.windowKind = dialogKind then
GetDHandler := h;
end;
end;
{$ENDC}
{Two new routines added by Ingemar 12/11-93 for WNE support:}
procedure SkelSetSleep (newSleep: Longint);
begin
sleepTicks := newSleep;
end;
procedure SkelSetMouseRgn (newMouseRgn: RgnHandle);
begin
mouseRgn := newMouseRgn;
end;
{Utility routine added by Ingemar july 1994. Finds a window in the window list that has the same}
{refCon as the value passed. This is useful for programs where several windows share window handlers.}
{(To be precise, i needed it for a program where I have several connections to other Macs over Appletalk.)}
function FindWindowByRefcon (theRefCon: Longint): WindowPtr;
var
h: WHandlerHnd;
begin
FindWindowByRefcon := nil;
h := WhList;
while h <> nil do
if WindowPeek(h^^.whWind)^.refCon = theRefCon then
begin
FindWindowByRefcon := h^^.whWind;
exit(FindWindowByRefcon);
end
else
h := WHandlerHnd(h^^.whNext);
end;
procedure SkelSetSuspendResume (p: ProcPtr);
begin
gSuspendResumeHandler := p;
end;
function SkelGetSuspendResume: ProcPtr;
begin
SkelGetSuspendResume := gSuspendResumeHandler;
end;
{The following procedures are Pascal "glue" that allows Pascal to call a Procedure }
{ from a ProcPtr. It is similar to (*p) () construct used in the C dialect. Different }
{ procedures are necessary for the reason of Pascal's strongly typed parameter }
{ list. Fortunately, there are not too many calls which use different param lists }
{The following procedures are Pascal "glue" that allows Pascal to call a Procedure }
{ from a ProcPtr. It is similar to (*p) () construct used in the C dialect. Different }
{ procedures are necessary for the reason of Pascal's strongly typed parameter }
{ list. Fortunately, there are not too many calls which use different param lists }
{NOTE: Metrowerks Pascal supports function types, which makes it possible to pass}
{ProcPtrs with type checking. That is MUCH better, so this is an interim solution.}
{$IFC GENERATINGPOWERPC }
{$ELSEC}
procedure CallpMouse (thePoint: Point; theTime: longint; theMods: integer; myProc: ProcPtr);
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
procedure CallpKey (theChar: char; theMods: integer; myProc: ProcPtr);
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
procedure CallpEvent (theitem: integer; var theEvent: EventRecord; myProc: ProcPtr);
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
function CallotherEvent (var theEvent: EventRecord; myProc: ProcPtr): Boolean;
inline
$205f, $4e90;
procedure CallpBoolean (myBool: Boolean; myProc: ProcPtr);
{ Two calls use Booleans as one parameter arguments. This procedure handles }
{ both of them. }
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
procedure CallpInt (myInt: integer; myProc: ProcPtr);
{ Two calls use Booleans as one parameter arguments. This procedure handles }
{ both of them. }
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
procedure CallpMenu (myMenu: MenuHandle; myProc: ProcPtr);
{ Handle removeal of menus. }
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
procedure Callpnoarg (myProc: ProcPtr);
{ For all the Procedures that are called with no arguments }
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
{ADDED BY INGEMAR 18/9-93 to support new dialog filters}
{IS IT POSSIBLE to use this for functions?}
procedure Callpfilter (theDialog: DialogPtr; var theEvent: EventRecord; var result: Boolean; myProc: ProcPtr);
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
{Some stuff that are here to avoid including EPPC and AppleEvents, added by Ingemar 23/7 -94}
const
kHighLevelEvent = 23;
function AEProcessAppleEvent (theEventRecord: EventRecord): OSErr;
inline
$303C, $021B, $A816;
{$ENDC}
{ General menu-handler. Just passes selection to the handler's}
{ select routine. If the select routine is nil, selecting items from}
{ the menu is a nop.}
procedure DoMenuCommand (command: longint);
var
menu: integer;
item: integer;
mh: MHandlerHnd;
p: ProcPtr;
begin
menu := HiWrd(command);
item := LoWrd(command);
mh := mhList;
while (mh <> nil) do
begin
p := mh^^.mhSelect;
if ((menu = mh^^.mhID) and (p <> nil)) then
begin
callpInt(item, p);
mh := nil;
end
else
mh := mh^^.mhNext;
end;
HiliteMenu(0);
end;
{ Apple menu handler}
{ DoAppleItem: If the first item was chosen, and there's an "About..."}
{ item, call the procedure associated with it (if not nil). If there}
{ is no "About..." item or the item was not the first one, then open}
{ the associated desk accessory. The port is saved and restored}
{ because OpenDeskAcc does not always preserve it correctly.}
{ DoAppleClobber disposes of the Apple menu.}
procedure DoAppleItem (item: integer);
var
curPort: GrafPtr;
str: Str255;
ignore: integer;
h: Handle;
begin
if doAbout and (item = 1) then
begin
if appleAboutProc <> nil then
callpnoarg(appleAboutProc);
end
else
begin
GetPort(curPort);
GetMenuItemText(appleMenu, item, str);
SetResLoad(false);
h := GetNamedResource('DRVR', str);
SetResLoad(true);
if h <> nil then
begin
ReserveMem(GetResourceSizeOnDisk(h) + $1000);
ignore := OpenDeskAcc(str);
end;
SetPort(curPort);
end;
end;
procedure DoAppleClobber;
begin
DisposeMenu(appleMenu);
end;
{ -------------------------------------------------------------------- }
{ Window-handler routing routines }
{ }
{ Each routine sets the port to the handler's window before executing }
{ the handler procedure. }
{ -------------------------------------------------------------------- }
{ Pass local mouse coordinates, click time, and the modifiers flag}
{ word to the handler. Should not be necessary to set the port, as}
{ the click is passed to the active window's hander. }
procedure DoMouse (h: WHandlerHnd; theEvent: EventRecord);
var
p: ProcPtr;
thePt: Point;
begin
if (h <> nil) then
begin
p := h^^.whMouse;
if p <> nil then
begin
thePt := theEvent.where;
GlobalToLocal(thePt);
callpMouse(thePt, theEvent.when, theEvent.modifiers, p);
end;
end;
end;
{ Pass the character and the modifiers flag word to the handler.}
{ Should not be necessary to set the port, as the click is passed to the}
{ active window's handler. }
procedure DoKey (h: WHandlerHnd; ch: char; mods: integer);
var
p: ProcPtr;
begin
if h <> nil then
begin
p := h^^.whKey;
if p <> nil then
callpKey(ch, mods, p);
end;
end;
{ Call the window updating procedure, passing to it an indicator whether the}
{ window has been resized or not. Then clear the flag, assuming the update}
{ proc took whatever action was necessary to respond to resizing.}
{}
{ If the handler doesn't have any update proc, the Begin/EndUpdate stuff}
{ is still done, to clear the update region. Otherwise the Window Manager }
{ will keep generating update events for the window, stalling updates of}
{ other windows. }
{ Make sure to save and restore the port, as it's not always the active window}
{ that's updated. }
procedure DoUpdate (h: WHandlerHnd);
var
rh: WhandlerHnd;
p: ProcPtr;
updPort, tmpPort: GrafPtr;
begin
rh := h;
if rh <> nil then
begin
GetPort(tmpPort);
updPort := rh^^.whWind;
SetPort(updPort);
BeginUpdate(updPort);
p := rh^^.whUpdate;
if p <> nil then
begin
callpBoolean(rh^^.whSized, p);
rh^^.whSized := false;
end;
EndUpdate(updPort);
SetPort(tmpPort);
end;
end;
{ Pass activate/deactivate notification to handler. On activate, set the port to}
{ the window coming active }
procedure DoActivate (h: WHandlerHnd; active: Boolean);
var
p: ProcPtr;
begin
if h <> nil then
begin
if active then
SetPort(h^^.whWind);
p := h^^.whActivate;
if p <> nil then
callpBoolean(active, p);
end
end;
{ Execute a window handler's close proc. The close box for handlers}
{ for temp windows that want to remove themselves when the window}
{ is closed can call SkelRmveWind to dispose of the window}
{ and remove the handler from the window handler list. Thus, windows}
{ may be dynamically created and destroyed without filling up the}
{ handler list with a bunch of invalid handlers.}
{ If the handler doesn't have a close proc, just hide the window.}
{ The host should provide some way of reopening the window (perhaps}
{ a menu selection). Otherwise the window will be lost from user}
{ control if it is hidden, since it won't receive user-initiated events.}
{ Since the close box of only the active window may be clicked, it}
{ is not necessary to set the port . }
{ This is called both for regular and dialog windows.}
procedure DoClose (h: WHandlerHnd);
var
rh: WHandlerHnd;
p: ProcPtr;
begin
rh := h;
if rh <> nil then
begin
p := rh^^.whClose;
if (p <> nil) then
callpnoarg(p)
else
HideWindow(rh^^.whWind);
end;
end;
{ Execute a window Handler's clobber proc. This is called both for regular and dialog windows.}
{ Must save, set and restore port, since any window (not just active one) may be clobbered }
{ at any time.}
{}
{ Don't need to check whether handler is nil, as in other handler procedures, since this is only}
{ called by SkelRmveWind with a known valid handler. }
procedure DoClobber (h: WHandlerHnd);
var
p: ProcPtr;
curPort: Grafptr;
begin
if (h <> nil) then
begin
GetPort(curPort);
SetPort(h^^.whWind);
p := h^^.whClobber;
if p <> nil then
callpnoarg(p);
SetPort(curPort);
end;
end;
{$IFC supportDialogs }
{ Handle event if it's for a dialog. The event must be one of}
{ those that is passed to dialogs according to dlogEventMask.}
{ This mask can be set so that disk-inserts, for instance, don't}
{ get eaten up.}
function DoDialog (theEvent: EventRecord): Boolean;
var
dh: WHandlerHnd;
theDialog: DialogPtr;
myDPeek: DialogPeek;
what: integer;
item: integer;
tmpPort: GrafPtr;
ignore: Boolean;
testme: longint;
hasfilter, filtered: Boolean;
begin
{ handle command keys before they get to IsDialogEvent}
what := theEvent.what;
testme := BSL(longint(1), what);
testme := BAnd(testme, longint(dlogEventMask));
if (((what = keydown) or (what = autokey)) and (BAnd(theEvent.modifiers, cmdkey) <> 0)) then
{ Bugfix by Ingemar above! }
begin
DoMenuCommand(MenuKey(Char(BAnd(theEvent.message, charCodeMask))));
DoDialog := true;
end
{Filter procedure, Added by Ingemar 18/9 -93:}
else
begin
{Check if theDialog has whFilter!}
{Bugfix 941026: I used FrontWindow, which was really silly since that won't work}
{for update events!}
theDialog := DialogPtr(theEvent.message);
dh := WHandlerHnd(GetDHandler(theDialog));
filtered := false;
hasfilter := dh <> nil;
if hasfilter then
hasfilter := dh^^.whFilter <> nil;
if hasfilter then
CallPFilter(theDialog, theEvent, filtered, dh^^.whFilter);
DoDialog := filtered;
if not filtered then
{end of filter proc handling}
{else}
if testme > 0 then
if IsDialogEvent(theEvent) then
begin
if DialogSelect(theEvent, theDialog, item) then
begin
dh := WHandlerHnd(GetDHandler(theDialog));
if (dh <> nil) then
if (dh^^.whEvent <> nil) then
begin
GetPort(tmpPort);
SetPort(theDialog);
callpEvent(item, theEvent, dh^^.whEvent);
SetPort(tmpPort);
end;
end;
DoDialog := true;
end
else
DoDialog := false;
end; {to match begin added with filter above}
end;
{$ENDC}
{ -------------------------------------------------------------------- }
{ Event-handling routines }
{ -------------------------------------------------------------------- }
{ Have either sized or zoomed the window. Invalidate it to force}
{ an update and set the 'resized' flag in the window handler true.}
{ The port is assumed to be set to the port that changed size. }
procedure TriggerUpdate (h: WHandlerHnd; thePort: GrafPtr);
begin
InvalRgn(thePort^.visRgn);
{Changed by Ingemar 1/4-94. Was: InvalRect(thePort^.portRect);}
{This is ok for rectangular windows, but all windows aren't rectangular!}
if (h <> nil) then
begin
h^^.whSized := true;
end;
end;
{ Size a window. If the window has a handler, use the grow limits}
{ in the handler record, otherwise use the defaults.}
{ The portRect is invalidated to force an update event. The handler's}
{ update procedure should check the parameter passed to it to check}
{ whether the window has changed size, if it needs to adjust itself to}
{ the new size. THIS IS A CONVENTION. Update procs must notice grow}
{ "events", there is no procedure specifically for such events.}
{ The clipping rectangle is not reset. If the host application}
{ keeps the clipping set equal to the portRect or something similar,}
{ then it will have to arrange to treat window growing with more}
{ care.}
{}
{ Since the grow region of only the active window may be clicked, it should}
{ not be necessary to set the port.}
procedure DoGrow (h: WHandlerHnd; thePort: GrafPtr; StartPt: Point);
var
r: Rect;
growRes: longint;
begin
if (h <> nil) then
begin
r := h^^.whGrow;
end
else
r := growRect;
growRes := GrowWindow(thePort, startPt, r);
if growRes <> 0 then
begin
SizeWindow(thePort, LoWrd(growRes), HiWrd(growRes), false);
TriggerUpdate(h, thePort);
end;
end;
{ Zoom the current window. Very similar to DoGrow}
{ Since the zoombox of only the active window may be clicked, it should not be necessary}
{ to set the port. }
procedure DoZoom (h: WHandlerHnd; thePort: GrafPtr; partcode: integer);
begin
ZoomWindow(thePort, partcode, false);
TriggerUpdate(h, thePort);
end;
{ General event handler}
procedure DoEvent (theEvt: Eventrecord);
var
theEvent: EventRecord;
evtPt: Point;
evtPort: GrafPtr;
evtPart: integer;
evtChar: char;
evtMods: integer;
h: WHandlerHnd;
r: Rect;
ignore: integer;
begin
theEvent := theEvt;
{$IFC supportDialogs }
if not (DoDialog(theEvent)) then
{$ENDC}
begin
evtPt := theEvent.where;
evtMods := theEvent.modifiers; {Bug fixed by Ingemar 941027 - this statement was missing}
case theEvent.what of
nullEvent:
;
{ Mouse click. Get the window that the click occurred in, and the}
{ part of the window. Get WDHandler is called here, not GetWHandler, since}
{ we need the handler for a window which might turn out to be a dialog window,}
{ e.g., if the click is in a close box.}
mouseDown:
begin
evtPart := FindWindow(evtPt, evtPort);
h := GetWDHandler(evtPort);
case evtPart of
{ Click in a desk accessory window. Pass back to the system.}
inSysWindow:
SystemClick(theEvent, evtPort);
{ Click in menu bar. Track the mouse and execute selected command,}
{ if any.}
inMenuBar:
DoMenuCommand(MenuSelect(evtPt));
{ Click in grow box. Resize window.}
inGrow:
DoGrow(h, evtPort, evtPt);
{ Click in title bar. Drag the window around. Leave at least}
{ 4 pixels visible in both directions. Bug fix: The window, if not front, is}
{ selected first to make sure it's at least activated (unless the command key is down - see Inside}
{ Macintosh). DragWindow seems to call StillDown first, so that clicks in drag regions while}
{ machine is busy don't otherwise bring window to front if the mouse is already up by the time}
{ DragWindow is called.}
{BUG??? Where is evtmods assigned???}
inDrag:
begin
if (evtPort <> FrontWindow) and (BAnd(evtmods, cmdKey) = 0) then
SelectWindow(evtPort);
r := screenPort^.portRect;
r.top := r.top + mBarHeight; { Skip down past menu bar }
InsetRect(r, 4, 4);
DragWindow(evtPort, evtPt, r);
end;
{ Click in close box. Call the close proc if the window has one.}
inGoAway:
if (TrackGoAway(evtPort, evtPt)) then
DoClose(GetWDHandler(evtPort));
{ Click in content region. If the window wasn't frontmost (active),}
{ just select it, otherwise pass the click to the window's mouse}
{ click handler.}
inContent:
if (evtPort <> FrontWindow) then
SelectWindow(evtPort)
else
DoMouse(h, theEvent);
{ Click in zoom box. Track the click and then zoom the window if}
{ necessary}
inZoomin, inZoomOut:
if (TrackBox(evtPort, evtPt, evtPart)) then
DoZoom(h, evtport, evtPart);
otherwise
;
end;{mousedown}
end;
{ Key event. If the command key was down, process as menu item}
{ selection, otherwise pass the character and the modifiers flags}
{ to the active window's key handler.}
{ If dialogs are supported, there's no check for command-key}
{ equivalents, since that would have been checked in DoDialog.}
keydown, autokey:
begin
evtChar := char(BAnd(theEvent.message, charCodeMask));
evtMods := theEvent.modifiers;
if BAnd(evtMods, cmdKey) > 0 then
DoMenuCommand(menuKey(evtChar))
else
DoKey(GetWHandler(FrontWindow), evtChar, evtMods);
end;
{ Update a window.}
updateEvt:
DoUpdate(GetWHandler(WindowPtr(theEvent.message)));
{ Activate or deactivate a window.}
activateEvt:
DoActivate(GetWHandler(WindowPtr(theEvent.message)), (BAnd(theEvent.modifiers, activeFlag) <> 0));
{ handle inserts of uninitialized disks}
diskEvt:
if (HiWrd(theEvent.message) <> noErr) then
begin
DILoad;
ignore := DIBadMount(diskInitPt, theEvent.message);
DIUnload;
end;
{ Handle suspend/resume and Apple Events, added by Ingemar 23/7 -94}
OSevt:
if gSuspendResumeHandler <> nil then
if BAND(BROTL(theEvent.message, 8), $FF) = SuspendResumeMessage then
CallPBoolean(BAnd(theEvent.message, 1) <> 0, gSuspendResumeHandler);
{ Handle Apple Events, added by Ingemar 23/7 -94}
kHighLevelEvent:
if AEProcessAppleEvent(theEvent) <> noErr then
;
otherwise
end;
end;
end;
{ -------------------------------------------------------------------- }
{ Interface (public) Routines }
{ -------------------------------------------------------------------- }
{ Initialize the various Macintosh Managers.}
{ Set default upper limits on window sizing.}
{ FlushEvents does NOT toss disk insert events, so that disks}
{ inserted while the application is starting up don't result}
{ in dead drives.}
{ NoMasters is the number of times to call MoreMasters. gzProc is the address of a user - provided}
{ grow zone function procedure to call if memory gets tight. Pass nil if none to be used. }
procedure SkelInit;
var
i: integer;
begin
{ For non-Lightspeed Pascal users, the following inits are included as a compile time option, }
{ See the $SETC definition at the beginning of the unit. }
{$IFC UNDEFINED THINK_PASCAL }
InitGraf(@qd.thePort);
InitFonts;
InitWindows;
InitMenus;
TEInit;
InitDialogs(nil);
MaxApplZone;
{$ENDC}
FlushEvents(everyEvent - diskMask, 0);
for i := 1 to noMasters do
MoreMasters;
if myGrowZone <> nil then
SetGrowZone(myGrowZone);
InitCursor;
{Added by Ingemar 12/11-93, for WNE-support:}
WNEImplemented := NGetTrapAddress($60, ToolTrap) <> NgetTrapAddress($9F, ToolTrap);
SkelSetSleep(defaultSleep);
SkelSetMouseRgn(nil);
{End WNE-support}
whList := nil;
whClobOnRmve := true;
SetRect(growRect, 80, 80, 512, 342 - mBarHeight);
mhList := nil;
mhClobOnRmve := true;
appleID := 0;
appleAboutProc := nil;
doAbout := false;
doneflag := 0;
pBkgnd := nil;
pEvent := nil;
pEventflag := false;
eventmask := everyEvent;
diskInitPt.v := 120;
diskInitPt.h := 100;
{$IFC supportDialogs }
dlogEventMask := $16f;
{$ENDC}
{ Set upper limits of window sizing to machine screen size. Allow}
{ for the menu bar.}
GetWMgrPort(screenport);
growRect.right := screenPort^.portRect.right;
growRect.bottom := screenPort^.portRect.bottom - mBarHeight;
{ Set caching global variables to nil }
oldWindow := nil;
oldWDHandler := nil;
end;
{ Main loop.}
{ Task care of DA's with SystemTask.}
{ Run background task if there is one.}
{ If there is an event, check for an event hook. If there isn't}
{ one defined, or if there is but it returns false, call the}
{ general event handler. (Hook returns true if TransSkel should}
{ ignore the event.)}
{ If no event, call the "no-event" handler for the front window and for}
{ any other windows with idle procedures that are always supposed}
{ to run. This is done in such a way that it is safe for idle procs}
{ to remove the handler for their own window if they want (unlikely,}
{ but...) This loop doesn't check whether the window is really}
{ a dialog window or not, but it doesn't have to, because such}
{ things always have a nil idle proc.}
{ }
{ doneFlag is reset upon exit. This allows it to be called}
{ repeatedly, or recursively.}
{ Null events are looked at (in SkelMain)}
{ and passed to the event handler. This is necessary to make sure}
{ DialogSelect gets called repeatedly, or the caret won't blink if}
{ a dialog has any editText items. Null events are not passed to any event-inspecting hook that may}
{ be installed.}
procedure SkelMain;
var
theEvent: EventRecord;
wh, wh2: WHandlerHnd;
w: WindowPtr;
haveEvent, testpevent, testbool: Boolean;
tmpPort: GrafPtr;
p: ProcPtr;
begin
while (doneFlag = 0) do
begin
if WNEImplemented then {Added by Ingemar 12/11-93, for WNE-support:}
begin
if (pBkgnd <> nil) then
callpnoarg(pBkgnd);
haveEvent := WaitNextEvent(eventMask, theEvent, sleepTicks, mouseRgn);
end
else
begin {Old way:}
SystemTask;
if (pBkgnd <> nil) then
callpnoarg(pBkgnd);
haveEvent := GetNextEvent(eventMask, theEvent);
end;
if (pEvent <> nil) then
testpevent := CallotherEvent(theEvent, pEvent)
else
testpevent := false;
{ following line fixed from version 1.02 & 1.03 [but was still buggy! /Ingemar]}
{$IFC supportDialogs }
if (pEvent = nil) or (testpevent = false) then {haveEvent and <- This is wrong for modeless dialogs according to page 416? Changed by Ingemar 6/8 -93}
{$ELSEC}
if haveEvent and ((pEvent = nil) or (testpevent = false)) then { Old line. IFC'ad by Ingemar 6/8 -93}
{$ENDC}
DoEvent(theEvent);
if not haveEvent then
begin
wh := whList;
GetPort(tmpPort);
while (wh <> nil) do
begin
wh2 := wh^^.whNext;
w := wh^^.whWind;
if ((w = FrontWindow) or not wh^^.whFrontOnly) then
begin
SystemTask;
if (wh^^.whIdle <> nil) then
begin
SetPort(wh^^.whWind);
p := wh^^.whIdle;
if (p <> nil) then
callpnoarg(p);
end;
end;
wh := wh2;
end;
SetPort(tmpPort);
end;
end;
doneFlag := 0;
end;
{ Tell SkelMain to stop}
procedure SkelWhoa;
begin
doneFlag := 1;
end;
{ Clobber all the menu, window and dialog handlers}
procedure SkelClobber;
begin
oldWDHandler := nil;
oldWindow := nil;
while (whList <> nil) do
begin
SkelRmveWind(whList^^.whWind);
end;
while (mhList <> nil) do
begin
SkelRmveMenu(GetMenuHandle(mhList^^.mhID));
end;
end;
{ -------------------------------------------------------------------- }
{ Menu-handler interface routines }
{ -------------------------------------------------------------------- }
{ Install handler for a menu. Remove any previous handler for it.}
{ Pass the following parameters:}
{ theMenu Handle to the menu to be handled. Must be created by host.}
{ pSelect Proc that handles selection of items from menu. If this is}
{ nil, the menu is installed, but nothing happens when items}
{ are selected from it.}
{ pClobber Proc for disposal of handler's data structures. Usually}
{ nil for menus that remain in menu bar until program}
{ termination.}
{ The menu is installed and drawn in the menu bar.}
{ Return false if no handler could be allocated, true if successful. }
function CommonSkelMenu (theMenu: MenuHandle; pSelect: ProcPtr; pClobber: ProcPtr): Boolean;
var
mh: MHandlerHnd;
myHand: Handle;
begin
mhClobOnRmve := false;
SkelRmveMenu(theMenu);
mhClobOnRmve := true;
myHand := NewHandle(Sizeof(MHandler));
CommonSkelMenu := false;
if myHand <> nil then
begin
CommonSkelMenu := true; { show we really got the memory }
mh := MHandlerHnd(myHand);
mh^^.mhNext := mhList;
mhList := MHandlerHnd(myHand);
mh^^.mhID := theMenu^^.menuID; { get menu id number }
mh^^.mhSelect := pSelect; { install selection handler }
mh^^.mhClobber := pClobber; { install disposal handler }
end;
end;
{ Install handler for a normal menu }
function SkelMenu;
var
success: Boolean;
begin
success := CommonSkelMenu(theMenu, pSelect, pClobber);
SkelMenu := success;
if success then
begin
InsertMenu(theMenu, 0); { put menu at end of menu bar }
if DrawBar then
DrawMenuBar;
end;
end;
{ Install handler for a hiearcical menu. Almost same as above.}
{ Added by Ingemar 22/8 -93}
function SkelHMenu;
var
success: Boolean;
begin
success := CommonSkelMenu(theMenu, pSelect, pClobber);
SkelHMenu := success;
if success then
begin
InsertMenu(theMenu, -1); { put menu at end of menu bar }
end;
end;
{ Remove a menu handler. This calls the handler's disposal routine}
{ and then takes the handler out of the handler list and disposes}
{ of it.}
{ Note that the menu MUST be deleted from the menu bar before calling}
{ the clobber proc, because the menu bar will end up filled with}
{ garbage if the menu was allocated with NewMenu (see discussion of}
{ DisposeMenu in Menu Manager section of Inside Macintosh).}
procedure SkelRmveMenu;
var
mID: integer;
h, h2: MHandlerHnd;
p: ProcPtr;
returnflag: Boolean;
begin
mID := theMenu^^.menuID;
returnflag := false;
if mhlist <> nil then
begin
if mhList^^.mhID = mID then
begin
h2 := mhlist;
mhList := h2^^.mhNext;
end
else
begin
h := mhList;
while (h <> nil) and not returnflag do
begin
h2 := h^^.mhNext;
if (h2 = nil) then
begin
h := nil;
returnflag := true;
end
else if h2^^.mhID = mID then
begin
h^^.mhNext := h2^^.mhNext;
h := nil;
end;
if h <> nil then
h := h2;
end;
end;
if not returnflag then
begin
DeleteMenu(mID);
DrawMenuBar;
p := h2^^.mhClobber;
if mhClobOnRmve and (p <> nil) then
callpMenu(theMenu, p);
DisposeHandle(Handle(h2));
end;
end;
end;
{ Install a handler for the Apple menu.}
{ SkelApple is called if TransSkel is supposed to handle the apple}
{ menu itself. The title is the title of the first item. If nil,}
{ then only desk accessories are put into the menu. If not nil, then}
{ the title is entered as the first item, followed by a gray line,}
{ then the desk accessories.}
{ SkelApple does not cause the menubar to be drawn, so if the Apple menu is the only menu, }
{ DrawMenuBar must be called afterward.}
{ No value is returned, unlike SkelMenu. It is assumed that SkelApple will be called so early in the}
{ application that the call to SkelMenu is virtually certain to succeed. }
procedure SkelApple;
var
appleTitle: Str255;
dummy: boolean;
begin
appleTitle := ' ';
appleTitle[1] := char($14);
appleID := 1;
AppleMenu := NewMenu(appleID, appleTitle);
if aboutTitle <> '' then
begin
doAbout := true;
AppendMenu(appleMenu, aboutTitle);
AppendMenu(appleMenu, '(-');
AppleAboutProc := aboutProc;
end;
AppendResMenu(appleMenu, 'DRVR');
dummy := SkelMenu(appleMenu, @DoAppleItem, @DoAppleClobber, false);
end;
{ -------------------------------------------------------------------- }
{ Window-handler interface routines }
{ -------------------------------------------------------------------- }
{ Install handler for a window. Remove any previous handler for it.}
{ Pass the following parameters:}
{ theWind Pointer to the window to be handled. Must be created by host.}
{ pMouse Proc to handle mouse clicks in window. The proc will be}
{ passed the point (in local coordinates), the time of the}
{ click, and the modifier flags word.}
{ pKey Proc to handle key clicks in window. The proc will be passed}
{ the character and the modifier flags word.}
{ pUpdate Proc for updating window. TransSkel brackets calls to update}
{ procs with calls to BeginUpdate and EndUpdate, so the visRgn}
{ is set up correctly. A flag is passed indicating whether the}
{ window was resized or not. BY CONVENTION, the entire portRect}
{ is invalidated when the window is resized. That way, the}
{ handler's update proc can redraw the entire content region}
{ without interference from BeginUpdate/EndUpdate. The flag}
{ is set to false after the update proc is called; the}
{ assumption is made that it will notice the resizing and}
{ respond appropriately.}
{ pActivate Proc to execute when window is activated or deactivated.}
{ A boolean is passed to it which is true if the window is}
{ coming active, false if it's going inactive.}
{ pClose Proc to execute when mouse clicked in close box. Useful}
{ mainly to temp window handlers that want to know when to}
{ self-destruct (with SkelRmveWind).}
{ pClobber Proc for disposal of handler's data structures}
{ pIdle Proc to execute when no events are pending.}
{ frontOnly True if pIdle should execute on no events only when}
{ theWind is frontmost, false if executes all the time. Note}
{ that if it always goes, everything else may be slowed down!}
{ If a particular procedure is not needed (e.g., key events are}
{ not processed by a handler), pass nil in place of the appropriate}
{ procedure address.}
{ Return false if no handler could be allocated, true if successful.}
function SkelWindow;
var
hHand: WhandlerHnd;
begin
whClobOnRmve := false;
SkelRmveWind(theWind);
whClobOnRmve := true;
{ Get new handler, attach to list of handlers. It is attached to the beginning of the list, which is simpler;}
{ the order should be irrelevant to the hose, anyway. }
hHand := WHandlerHnd(NewHandle(Sizeof(WHandler)));
SkelWindow := false;
if hHand <> nil then
begin
hHand^^.whNext := whList;
whList := hHand;
with hHand^^ do
begin
SkelWindow := true; { Show that we got the memory }
whWind := theWind;
whMouse := pMouse;
whKey := pKey;
whUpdate := pUpdate;
whActivate := pActivate;
whClose := pClose;
whClobber := pClobber;
whIdle := pIdle;
whFrontOnly := frontOnly;
whSized := false;
whGrow := GrowRect;
end;
end;
SetPort(theWind); {Is this allowed for hidden windows? I thought so, but… /Ingemar, dec 93}
end;
{ Remove a window handler. This calls the handler's disposal routine}
{ and then takes the handler out of the handler list and disposes}
{ of it.}
{ SkelRmveWind is also called by SkelRmveDlog.}
{ Note that if the window cache variable is set to the window whose handler is being clobbered, the }
{ variable must be zeroed. }
procedure SkelRmveWind;
var
h, h2: WHandlerHnd;
returnflag: Boolean;
begin
if theWind = oldWindow then
begin
oldWindow := nil;
{• oldWDHandler := nil;•}
end;
if (whList <> nil) then
begin
returnflag := false;
if whList^^.whWind = theWind then
begin
h2 := whlist;
whList := whList^^.whNext;
end
else
begin
h := whList;
while (h <> nil) and not returnflag do
begin
h2 := h^^.whNext;
if (h2 = nil) then
begin
h := nil;
returnflag := true;
end
else if h2^^.whWind = theWind then
begin
h^^.whNext := h2^^.whNext;
h := nil;
end;
if h <> nil then
h := h2;
end;
end;
if not returnflag then
begin
if (whClobOnRmve) then
DoClobber(h2);
DisposeHandle(Handle(h2));
end;
end;
end;
{$IFC supportDialogs }
{ -------------------------------------------------------------------- }
{ Dialog-handler interface routines }
{ -------------------------------------------------------------------- }
{ Install a dialog handler. Remove any previous handler for it.}
{ SkelDialog calls SkelWindow as a subsidiary to install a window}
{ handler, then sets the event procedure on return.}
{ Pass the following parameters:}
{ theDialog Pointer to the dialog to be handled. Must be created}
{ by host.}
{ pEvent Event-handling proc for dialog events.}
{ pClose Proc to execute when mouse clicked in close box. Useful}
{ mainly to dialog handlers that want to know when to}
{ self-destruct (with SkelRmveDlog).}
{ pClobber Proc for disposal of handler's data structures}
{ If a particular procedure is not needed, pass nil in place of}
{ the appropriate procedure address.}
{ Return false if no handler could be allocated, true if successful.}
function SkelDialog;
var
wh: WHandlerHnd;
aBool: Boolean;
begin
aBool := SkelWindow(theDialog, nil, nil, nil, nil, pClose, pClobber, nil, false);
if aBool <> false then
begin
wh := GetWDHandler(theDialog);
wh^^.whEvent := pEvent;
{Added by Ingemar 18/9 -93:}
wh^^.whFilter := pFilter; {Install a filter function to be called *before* IsDialogEvent!}
end;
SkelDialog := aBool;
end;
{ Remove a dialog and its handler}
procedure SkelRmveDlog;
begin
SkelRmveWind(theDialog);
end;
{$ENDC}
{ -------------------------------------------------------------------- }
{ Miscellaneous interface routines }
{ -------------------------------------------------------------------- }
{ Override the default sizing limits for a window, or, if theWind}
{ is nil, reset the default limits used by SkelWindow.}
procedure SkelGrowBounds;
var
h: WHandlerHnd;
r: Rect;
begin
if theWind = nil then
SetRect(growRect, hLo, vLo, hHi, vHi)
else
begin
h := GetWHandler(theWind);
if h <> nil then
begin
SetRect(r, hLo, vLo, hHi, vHi);
h^^.whGrow := r;
end;
end;
end;
{ Set the event mask.}
procedure SkelEventMask;
begin
eventMask := mask;
end;
{ Return the event mask.}
procedure SkelGetEventMask;
begin
mask := eventMask;
end;
{ Install a background task. If p is nil, the current task is}
{ disabled.}
procedure SkelBackground;
begin
pBkgnd := p;
end;
{ Return the current background task. Return nil if none.}
procedure SkelGetBackground;
begin
p := pBkgnd;
end;
{ Install an event-inspecting hook. If p is nil, the hook is}
{ disabled.}
procedure SkelEventHook;
begin
pEvent := p;
end;
procedure SkelGetEventHook;
begin
p := pEvent;
end;
{$IFC supportDialogs }
{ Set the mask for event types that will be passed to dialogs.}
{ Bit 1 is always set, so that null events will be passed.}
{ If this is not done, the caret does not blink in editText items.}
procedure SkelDlogMask;
begin
dlogEventMask := BitOr(mask, 1);
end;
{ Return the current dialog event mask.}
procedure SkelGetDlogMask;
begin
mask := dlogEventMask;
end;
{$ENDC}
end.